perm filename PREDIC.LSP[BNF,JRA]1 blob sn#022410 filedate 1973-02-02 generic text, type T, neo UTF8
00100	
00200	
00300	(DEFPROP <PREDIC> 
00400	 (LAMBDA NIL
00500	  (NLRR (QUOTE PREDIC)
00600		(FUNCTION
00700		 (LAMBDA NIL
00800		  (COND ((AND (SPWD ANCESTRY)) (QUOTE ANCESTRY))
00900			((AND (SPWD NONE)) (QUOTE NONE))
01000			((AND (SPWD VINE)) (QUOTE VINE))
01100			((AND (SPWD UNIT)) (QUOTE UNIT))
01200			((AND (SPWD P1)) (QUOTE ALLPOS))
01300			((AND (SPWD P2)) (QUOTE ALLNEG))
01400			((AND (SPWD SUPPORT) (CH /[) (<C>) (CH /])) (CONS (QUOTE SUPPORT) (STK 1)))
01500			((AND (SPWD MODEL) (CH /[) (<PREDLST>) (CH ;) (<PREDLST1>) (CH /]))
01600			 (CONS (QUOTE MODEL) (CONS (STK 3) (CONS (STK 1) NIL))))
01700			((AND (SPWD EQUALITY) (CH /[) (<OP>) (CH /,) (<NUMBER>) (CH /]))
01800			 (CONS (QUOTE EQUALITY) (CONS (STK 3) (CONS (STK 1) NIL))))
01900			((AND (SPWD DEMOD) (CH /[) (<CLAUSES>) (CH /,) (<NUMBER>) (CH /]))
02000			 (CONS (QUOTE DEMOD) (CONS (STK 3) (CONS (STK 1) NIL))))
02100			((AND (SPWD DEFMODEL) (CH /[) (SPWD ID) (CH /])) (CONS (QUOTE DEFMODEL) (QUOTE ID)))
02200			((AND (CH /@) (<LISPR>)) (STK 0))
02300			((AND (<TERM0>) (<OPR>) (<TERM>)) (CONS (STK 1) (CONS (STK 2) (CONS (STK 0) NIL))))
02400			(*NIL*)))))) 
02500	EXPR)
02600	
02700	(DEFPROP <PREDLST1> 
02800	 (LAMBDA NIL (NLRR (QUOTE PREDLST1) (FUNCTION (LAMBDA NIL (COND ((AND (<PREDLST>)) (STK 0)) (*NIL*)))))) 
02900	EXPR)
03000	
03100	(DEFPROP <PREDLST> 
03200	 (LAMBDA NIL
03300	  (NLRR (QUOTE PREDLST)
03400		(FUNCTION
03500		 (LAMBDA NIL
03600		  (COND ((AND (<ID>) (CH /,) (<PREDLST>)) (CONS (STK 2) (STK 0)))
03700			((AND (<ID>)) (STK 0))
03800			((AND) NIL)
03900			(*NIL*)))))) 
04000	EXPR)
04100	
04200	(DEFPROP >PREDIC< 
04300	 (LAMBDA(%N)
04400	  (OUTRUL %N
04500		  (FUNCTION
04600		   (LAMBDA NIL
04700		    (COND ((EQ (QUOTE ANCESTRY) (STK1)) (QUOTE ANCESTRY))
04800			  ((EQ (QUOTE NONE) (STK1)) (QUOTE NONE))
04900			  ((EQ (QUOTE VINE) (STK1)) (QUOTE VINE))
05000			  ((EQ (QUOTE UNIT) (STK1)) (QUOTE UNIT))
05100			  ((EQ (QUOTE ALLPOS) (STK1)) (QUOTE P1))
05200			  ((EQ (QUOTE ALLNEG) (STK1)) (QUOTE P2))
05300			  ((AND (MATCH (QUOTE (SUPPORT . *))) (>C< 0))
05400			   (LIST (QUOTE SUPPORT) (QUOTE (:CH /[)) (STK0) (QUOTE (:CH /]))))
05500			  ((AND (MATCH (QUOTE (MODEL * *))) (>PREDLST< 1) (>PREDLST1< 0))
05600			   (LIST (QUOTE MODEL) (QUOTE (:CH /[)) (STK1) (QUOTE (:CH ;)) (STK0) (QUOTE (:CH /]))))
05700			  ((AND (MATCH (QUOTE (EQUALITY * *))) (>OP< 1) (>NUMBER< 0))
05800			   (LIST (QUOTE EQUALITY) (QUOTE (:CH /[)) (STK1) (QUOTE (:CH /,)) (STK0) (QUOTE (:CH /]))))
05900			  ((AND (MATCH (QUOTE (DEMOD * *))) (>CLAUSES< 1) (>NUMBER< 0))
06000			   (LIST (QUOTE DEMOD) (QUOTE (:CH /[)) (STK1) (QUOTE (:CH /,)) (STK0) (QUOTE (:CH /]))))
06100			  ((AND (MATCH (QUOTE (DEFMODEL . ID))))
06200			   (LIST (QUOTE DEFMODEL) (QUOTE (:CH /[)) (QUOTE ID) (QUOTE (:CH /]))))
06300			  ((AND (MATCH (QUOTE (* * *))) (>OPR< 2) (>TERM0< 1) (>TERM< 0)) (LIST (STK1) (STK2) (STK0)))
06400			  ((>LISPR< 1) (LIST (QUOTE (:CH /@)) (STK1)))))))) 
06500	EXPR)
06600	
06700	(DEFPROP >PREDLST1< 
06800	 (LAMBDA (%N) (OUTRUL %N (FUNCTION (LAMBDA NIL (COND ((>PREDLST< 1) (STK1))))))) 
06900	EXPR)
07000	
07100	(DEFPROP >PREDLST< 
07200	 (LAMBDA(%N)
07300	  (OUTRUL %N
07400		  (FUNCTION
07500		   (LAMBDA NIL
07600		    (COND ((EQ (QUOTE NIL) (STK1)) FOOBAZ)
07700			  ((AND (MATCH (QUOTE (* . *))) (>ID< 1) (>PREDLST< 0)) (LIST (STK1) (QUOTE (:CH /,)) (STK0)))
07800			  ((>ID< 1) (STK1))))))) 
07900	EXPR)